\ Examples of menu words Ham 12:00 11/01/92 \ This file contains four versions of a menu-presentation \ word. To see how to exercise the words, load screen 1. \ Use the "Index" function to see the title lines in the \ file. \ Load this screen to see list of menus Ham 12:00 11/01/92 CR CR .( Execute this for this example.) CR CR .( 2 LOAD Example 1 ) CR .( 10 LOAD Example 2 ) CR .( 13 LOAD Example 3 ) CR .( 16 LOAD Example 4 ) CR CR .( Look at examples in order from 1 to 4.) CR \ Basic tools Ham 12:00 11/01/92 : PCKEY ( -- ASCII-char -1 | IBM-special_char 0 ) KEY ?DUP IF TRUE ELSE KEY FALSE THEN ; : SMLCUR 6 7 SET-CUR ; \ normal cursor : BIGCUR 0 14 SET-CUR ; \ block cursor : NO-CUR 14 0 SET-CUR ; \ no cursor VARIABLE SOUND \ T if using sound : BELL ( - ) SOUND @ IF 440 10 BEEP ( short beep ) THEN ; --> \ General parameters Ham 12:00 11/01/92 VARIABLE OPTION-ARRAY \ the address of array of options VARIABLE #OPTIONS \ the number of options VARIABLE ELTS/COL \ the number of elments in a column : OPTIONS ( - adr ) OPTION-ARRAY @ ; \ address of array : #OPTS ( - n ) #OPTIONS @ ; \ leave number of options : #/COL ( - n ) ELTS/COL @ ; \ leave # of elts in a column --> \ Put options here Ham 12:00 11/01/92 : "0 15 5 GOTOXY ." Option zero " ; : "1 15 7 GOTOXY ." Option one " ; : "2 15 9 GOTOXY ." Option two " ; : "3 45 5 GOTOXY ." Option three " ; : "4 45 7 GOTOXY ." Option four " ; : "5 45 9 GOTOXY ." Options five " ; CREATE THESE-OPTIONS ] "0 "1 "2 "3 "4 "5 [ : SETUP1 SOUND ON 6 #OPTIONS ! 3 ELTS/COL ! THESE-OPTIONS OPTION-ARRAY ! ; --> \ Option arithmetic Ham 12:00 11/01/92 : PLAIN ( # - ) WSIZE * OPTIONS + PERFORM ; \ show plain : FANCY ( # - ) REVERSE PLAIN -REVERSE ; \ show inversed : SHOWALL ( # - # ) #OPTS 0 DO I 2DUP = IF FANCY ELSE PLAIN THEN LOOP ; --> SHOWALL expects the default option number on the stack and leaves it there. Otherwise, you have a DUP before SHOWALL and a DROP at the end of SHOWALL; by leaving it there, you save two instructions. Note that you can have an undelimited comment in the screen following the -->. When --> is encountered during loading, Forth goes immediately to the next screen. \ Definitions for keys Ham 12:00 11/01/92 75 CONSTANT LEFTKEY \ key value for left arrow 77 CONSTANT RIGHTKEY \ key value for right arrow 72 CONSTANT UPKEY \ key value for up arrow 80 CONSTANT DOWNKEY \ key value for down arrow 13 CONSTANT ENTERKEY \ key value for enter key \ In using the case statement (screen #7), it was more efficient\ to factor out the similarities that existed in the definitions\ of UP DOWN LEFT and RIGHT (as shown in the file ANSWERS.SCR), \ and this freed the names to be used for constants. Note how \ in GETOPTIONS the duplication of code is minimized by putting \ PLAIN before the CASE statement and OPCLIP DUP FANCY after it. --> \ Clip options and fold directions Ham 12:00 11/01/92 : OPCLIP ( # - #' ) #OPTS MOD ; \ keep opt # in range \ The above is just an abbreviation to explain what's happening. : FOLDLF ( # - #' ) #OPTS #/COL = IF 1- ELSE #/COL - THEN ; : FOLDRT ( # - #' ) #OPTS #/COL = IF 1+ ELSE #/COL + THEN ; \ In a single-column menu, FOLDLF will fold left and up \ and FOLDRT right and down. --> \ Sample option selection Ham 12:00 11/01/92 : GETOPTION ( # - # ) \ first initialize # of options, adr of \ of option array; stack contains default option number NO-CUR SHOWALL BEGIN PCKEY IF ( ascii ) ENTERKEY = DUP NOT IF BELL THEN ELSE ( special key ) OVER PLAIN CASE UPKEY OF 1- ENDOF DOWNKEY OF 1+ ENDOF LEFTKEY OF FOLDLF ENDOF RIGHTKEY OF FOLDRT ENDOF BELL ENDCASE OPCLIP DUP FANCY FALSE \ to repeat THEN UNTIL ; --> \ Example run 1 Ham 12:00 11/01/92 \ This screen exercises the code: no definitions, just phrases \ to be executed when the screen lis loaded. CLS 30 2 GOTOXY .( Sample of menu run) SETUP1 \ initialize control variables 1 GETOPTION \ collection option; 1 is default option number 0 13 GOTOXY .( Option ) . .( chosen. ) SMLCUR 1 LOAD \ New constants for new options Ham 12:00 11/01/92 \ This assumes that words defined in screens 1 through 6 \ are in the dictionary. 15 CONSTANT TABLKEY \ key value for tab left (special key) 9 CONSTANT TABRKEY \ key value for tab right (normal key) --> \ Version 2 of option selection Ham 12:00 11/01/92 : GETOPTION ( # - # ) \ stack contains default option number NO-CUR SHOWALL BEGIN PCKEY IF ( ascii ) CASE ENTERKEY OF TRUE ( to exit ) ENDOF BL OF DUP PLAIN 1+ OPCLIP DUP FANCY FALSE ENDOF TABRKEY OF DUP PLAIN FOLDRT OPCLIP DUP FANCY FALSE ENDOF BELL FALSE SWAP ( put key value on top ) ENDCASE ELSE ( special key ) OVER PLAIN CASE UPKEY OF 1- ENDOF DOWNKEY OF 1+ ENDOF LEFTKEY OF FOLDLF ENDOF RIGHTKEY OF FOLDRT ENDOF TABLKEY OF FOLDLF ENDOF BELL ENDCASE OPCLIP DUP FANCY FALSE THEN UNTIL ; --> \ Example run 2 Ham 12:00 11/01/92 CLS 30 2 GOTOXY .( Sample of menu run) SETUP1 \ initialize control variables 2 GETOPTION \ collection option; 2 is default option number 0 13 GOTOXY .( Option ) . .( chosen. ) SMLCUR 1 LOAD \ Single-line menu Ham 12:00 11/01/92 : 1" 0 23 GOTOXY ." Achieve " ; : 2" 9 23 GOTOXY ." Believe " ; : 3" 18 23 GOTOXY ." Conceive " ; : 4" 28 23 GOTOXY ." Deceive " ; : 5" 37 23 GOTOXY ." Edward " ; CREATE NEW-OPTIONS ] 1" 2" 3" 4" 5" [ : SETUP2 SOUND ON 5 #OPTIONS ! 1 ELTS/COL ! NEW-OPTIONS OPTION-ARRAY ! ; --> \ Version 3 of option selection Ham 12:00 11/01/92 : GETOPTION ( # - # ) \ default option on stack or stack empty DEPTH 0= IF 0 THEN NO-CUR SHOWALL BEGIN PCKEY IF ( ascii ) CASE ENTERKEY OF EXIT ( to exit ) ENDOF BL OF DUP PLAIN 1+ OPCLIP DUP FANCY FALSE ENDOF TABRKEY OF DUP PLAIN FOLDRT OPCLIP DUP FANCY FALSE ENDOF BELL FALSE SWAP ( key value on top of stack ) ENDCASE ELSE ( special key ) OVER PLAIN CASE UPKEY OF 1- ENDOF DOWNKEY OF 1+ ENDOF LEFTKEY OF FOLDLF ENDOF RIGHTKEY OF FOLDRT ENDOF TABLKEY OF FOLDLF ENDOF BELL ENDCASE OPCLIP DUP FANCY FALSE THEN UNTIL ; --> \ Example run 3 Ham 12:00 11/01/92 CLS 30 2 GOTOXY .( Sample of menu run) SETUP2 \ initialize control variables 3 GETOPTION \ collection option; 3 is default option number 0 13 GOTOXY .( Option ) . .( chosen. ) SMLCUR 1 LOAD \ Put options here Ham 12:00 11/01/92 : "0. 15 5 GOTOXY ." 1. Option zero " ; \ This time they're : "1. 15 7 GOTOXY ." 2. Option one " ; \ all the same length: "2. 15 9 GOTOXY ." 3. Option two " ; \ Compare the effect : "3. 45 5 GOTOXY ." 4. Option three " ; \ of this to the : "4. 45 7 GOTOXY ." 5. Option four " ; \ options as in : "5. 45 9 GOTOXY ." 6. Options five " ; \ Screen #4. CREATE OPTIONS-3 ] "0. "1. "2. "3. "4. "5. [ : SETUP3 SOUND ON 6 #OPTIONS ! 3 ELTS/COL ! OPTIONS-3 OPTION-ARRAY ! ; --> \ Converting L or l to 1 Ham 12:00 11/01/92 : L>1 ( char - char' ) DUP ASCII L = OVER ASCII l = OR IF DROP ASCII 1 THEN ; --> The above word accommodates touch typists who are accustomed to typing lower-case 'l' for the numeral '1'. Rather than rejecting the keystroke, the above word determines whether the character is L or l; if it is, the character for 1 is substituted. Other characters are unaffected. \ Checking for numbers Ham 12:00 11/01/92 : #&OK? ( char - flag ) \ true if number in range DUP ASCII 0 > \ number must be greater than 0 SWAP ASCII 1 #OPTS + < AND ; \ & less than #OPTS + 1 : #WORK ( # char - #' ) \ clean up display, leave choice SWAP PLAIN ( turn off old option ) ASCII 1 - ( convert character to zero-based option # ) DUP FANCY ( show new option ) ; --> The format of these two definitions requires more room but also offers more explanation. It is particularly useful for code that is revisited infrequently. Without reminders, old code can sometimes be obscure. \ ASCII-KEY routine Ham 12:00 11/01/92 : ASCII-KEY ( # c - #' flag ) \ c = key; # = option number L>1 DUP #&OK? IF ( number ) #WORK TRUE ELSE ( not a number ) CASE ENTERKEY OF TRUE ( to exit ) ENDOF BL OF DUP PLAIN 1+ OPCLIP DUP FANCY FALSE ENDOF TABRKEY OF DUP PLAIN FOLDRT OPCLIP DUP FANCY FALSE ENDOF BELL FALSE SWAP ( key value on top ) ENDCASE THEN ; --> \ SPECIAL-KEY routine Ham 12:00 11/01/92 : SPECIAL-KEY ( # c - #' flag ) \ special keys; # = option no. OVER PLAIN CASE UPKEY OF 1- ENDOF DOWNKEY OF 1+ ENDOF LEFTKEY OF FOLDLF ENDOF RIGHTKEY OF FOLDRT ENDOF TABLKEY OF FOLDLF ENDOF BELL ENDCASE OPCLIP DUP FANCY FALSE ; --> \ Version 4 of option selection Ham 12:00 11/01/92 \ Note how this definition looks much simpler because ASCII-KEY \ and SPECIAL-KEY were factored out for separate definition. : GETOPTION ( # - # ) \ default option on stack or stack empty NO-CUR DEPTH 0= IF 0 THEN SHOWALL BEGIN PCKEY IF ASCII-KEY ELSE SPECIAL-KEY THEN UNTIL ; --> \ Example run 4 Ham 12:00 11/01/92 CLS 30 2 GOTOXY .( Sample of menu run) SETUP3 \ initialize control variables 4 GETOPTION \ collection option; 4 is default option number 0 13 GOTOXY .( Option ) . .( chosen. ) SMLCUR 1 LOAD
